home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 4 / FM Towns Free Software Collection 4 - Disc 1.iso / t_os / medit / medit.bas < prev    next >
BASIC Source File  |  1991-10-18  |  7KB  |  155 lines
  1. 1000 '
  2. 1010 '  Memory Editor  MEDIT  Ver1.11                   1991/08/31
  3. 1020 '                                   Programed by でんちゃん♪
  4. 1030 '
  5. 1040 '                                         電脳わ～るど DW0001
  6. 1050 '
  7. 1060 CLEAR,,,,1024:DEFLNG A-Z:LOADM "MEDIT.REX",0
  8. 1070 DIM ASCII$(15),SEC$(2),X_SM(15),Y_SM(15)
  9. 1080 DIM CSR$(2),MODE$(1):SEG=&H14
  10. 1090 CSR$(0)="<":CSR$(1)=">":CSR$(2)=CHR$(254)
  11. 1100 MODE$(0)="(HEX MODE)":MODE$(1)="(ASC MODE)"
  12. 1110 HEXKEY$="___0Mmﾐ1Jjﾓ2Kkﾈ3Llﾙ4Uuﾏ5Iiﾉ6Ooﾘ777ﾅ888ﾆ999ﾗ"
  13. 1120 HEXKEY$=HEXKEY$+"Aa*ﾔBb/ﾕCc+ﾖDd-ﾜEe=ｾFf.ﾚ"
  14. 1130 FOR I=1 TO 17:READ A:CTRL$=CTRL$+CHR$(A):NEXT
  15. 1140 DATA 5,8,9,11,12,13,17,18,22,23,26,27,28,29,30,31,127
  16. 1150 DEF FNHEX$(D)   =RIGHT$("0"+HEX$(D),2)
  17. 1160 DEF FNADDR$(D)  =RIGHT$("000000"+HEX$(D),7)
  18. 1170 DEF FNGET(D$,P) =ASC(MID$(D$,P+1,1))
  19. 1180 DEF FNREC$(F$,R)=LEFT$(F$,INSTR(F$,":"))+"("+MID$(STR$(R),2)+")"+                            MID$(F$,INSTR(F$,":")+1)
  20. 1190 CLS:COLOR 7,0:WIDTH 80,25:CONSOLE 22,2,2
  21. 1200 LOCATE  5,0:PRINT "Memory Editor MEDIT  Ver1.10"
  22. 1210 LOCATE 50,0:PRINT "Programed by でんちゃん♪"
  23. 1220 LOCATE  0,2:PRINT "  Addr :+0 +1 +2 +3 +4 +5 +6 +7,+8 +9 +A";
  24. 1230             PRINT " +B +C +D +E +F:SM  <  A S C I I   >"
  25. 1240 PRINT STRING$(76,"-"):A$=SPACE$(7)+":"+SPACE$(23)+","+SPACE$(23)+":"
  26. 1250 FOR Y=0 TO 15:PRINT A$:NEXT
  27. 1260 PRINT STRING$(76,"-"),"  Sum";MID$(A$,6);
  28. 1270 GOSUB *OPEN:GOSUB *MODE_PRINT:GOSUB *SEG_PRINT
  29. 1280 GOSUB *CSR_ON:GOSUB *COMMAND:GOTO 1280
  30. 1290 '
  31. 1300 *BLOCK_PRINT
  32. 1310  FOR X=0 TO 15:Y_SM(X)=0:NEXT:Z_SM=0:Y=0:GOTO *PRINT
  33. 1320 *HARF_PRINT
  34. 1330  IF Y_SIT=0 THEN *BLOCK_PRINT
  35. 1340  Z_SM=0
  36. 1350  FOR XP=0 TO 15
  37. 1360   Y_SM(XP)=0
  38. 1370   FOR YP=0 TO Y_SIT-1
  39. 1380    Y_SM(XP)=Y_SM(XP)+FNGET(ASCII$(YP),XP)
  40. 1390   NEXT
  41. 1400   Z_SM=Z_SM+Y_SM(XP)
  42. 1410  NEXT
  43. 1420  Y=Y_SIT:GOTO *PRINT
  44. 1430  *PRINT
  45. 1440   LOCATE 0,Y+4:B=BLK*256
  46. 1450   FOR YP=Y TO 15
  47. 1460    L$=FNADDR$(B+YP*16):X_SM(YP)=0
  48. 1470    FOR XP=0 TO 15
  49. 1480     DAT=FNGET(ASCII$(YP),XP):L$=L$+" "+FNHEX$(DAT)
  50. 1490     X_SM(YP)=X_SM(YP)+DAT:Y_SM(XP)=Y_SM(XP)+DAT
  51. 1500    NEXT
  52. 1510    MID$(L$,8,1)=":":MID$(L$,32,1)=",":PRINT L$+":"+FNHEX$(X_SM(YP))
  53. 1520    Z_SM=Z_SM+X_SM(YP):YL=YP+4:GOSUB *ASC_PRINT
  54. 1530   NEXT
  55. 1540   L$=""
  56. 1550   FOR X=0 TO 15:L$=L$+" "+FNHEX$(Y_SM(X)):NEXT:MID$(L$,25,1)=","
  57. 1560   LOCATE 8,21:PRINT MID$(L$,2)+":"+FNHEX$(Z_SM);:GOTO *KEY_CLR
  58. 1570 *SM_PRINT
  59. 1580  XL=X_SIT*3+8:YL=Y_SIT+4
  60. 1590  LOCATE 56,YL:PRINT FNHEX$(X_SM(Y_SIT))
  61. 1600  LOCATE XL,YL:PRINT FNHEX$(CHNG)
  62. 1610  LOCATE XL,21:PRINT FNHEX$(Y_SM(X_SIT));
  63. 1620  LOCATE 56,21:PRINT FNHEX$(Z_SM);:GOTO *ASC_PRINT
  64. 1630 *ASC_PRINT
  65. 1640  IF ASC_FLG THEN RETURN
  66. 1650  A=YL*19:LINE (480,A)-STEP(136,19),PRESET,,BF
  67. 1660  SYMBOL(480,A),ASCII$(YL-4),1,1,7:RETURN
  68. 1670 *CSR_ON  COLOR 15:GOTO 1690
  69. 1680 *CSR_OFF COLOR  7:CLS 1
  70. 1690  GOSUB *DAT_GET:Y=Y_SIT+4:A=MODE*2+BEAM
  71. 1700  LOCATE X_SIT*3+BEAM+8,Y:PRINT MID$(DAT$,BEAM+1,MODE+1)
  72. 1710  SYMBOL(X_SIT*8+480,Y*19),CSR$(A),1,1,2^A,,XOR:RETURN
  73. 1720 *MODE_PRINT LOCATE  2, 1:PRINT MODE$(MODE):RETURN
  74. 1730 *移禁 LOCATE 0,23:PRINT "移行できません":RETURN
  75. 1740 *SEG_PRINT
  76. 1750  LOCATE 60,21:PRINT "Selector = $"+RIGHT$("000"+HEX$(SEG),4);
  77. 1760  RETURN
  78. 1770 '
  79. 1780 *COMMAND
  80. 1790  GOSUB *KEY_IN:GOSUB *CSR_OFF
  81. 1800  ON INSTR(CTRL$,KEY_DAT$) GOTO *EL,*BS,*TAB,*HOME,*CLS,*CR,*DUP,*INS,           *BACK,*NEXT,*EOF,*ESC,*MV_R,*MV_L,*MV_U,*MV_D,*DEL
  82. 1810  IF MODE THEN *ASC_SET ELSE *HEX_SET
  83. 1820  *EL   MID$(ASCII$(Y_SIT),X_SIT+1,16)=STRING$(16,CHR$(0))
  84. 1830        BEAM=0:ED_FLG=1:GOTO *HARF_PRINT
  85. 1840  *BS   P=Y_SIT*16+X_SIT:ED_FLG=1:IF P ELSE 1900
  86. 1850        IF P>128 THEN GOSUB 1880 ELSE GOSUB 1870
  87. 1860        GOTO *HARF_PRINT
  88. 1870        MID$(SEC$(0),P,128)=MID$(SEC$(0),P+1)+SEC$(1):P=129
  89. 1880        MID$(SEC$(1),P-128,128)=MID$(SEC$(1),P-127)
  90. 1890        BEAM=0:GOSUB *MV_L:BEAM=0:RETURN
  91. 1900        GOSUB *DAT_GET:CHNG=DAT:P=1:GOSUB 1870:ED_FLG=1:GOTO *DAT_CHNG
  92. 1910  *TAB  LOCATE 0,23:GOSUB *KEY_CLR:INPUT "Move Address ? $",A$
  93. 1920        REC=BLK:IF A$="" THEN *ARG_SET
  94. 1930        IF LEFT$(A$,1)="S" OR LEFT$(A$,1)="s" THEN 1970
  95. 1940        SIZ=VAL("&H"+A$):BLK=INT(SIZ/256)
  96. 1950        Y_SIT=INT((SIZ MOD 256)/16):X_SIT=SIZ MOD 16
  97. 1960        IF REC=BLK THEN RETURN ELSE *ARG_SET
  98. 1970        SEG=VAL("&H"+MID$(A$,2)):BLK=0:Y_SIT=0:X_SIT=0
  99. 1975        GOSUB *SEG_PRINT:GOTO *ARG_SET
  100. 1980  *HOME BEAM=0:X_SIT=0:Y_SIT=0:RETURN
  101. 1990  *CLS  FOR I=0 TO 1:MID$(SEC$(I),1,128)=STRING$(128,CHR$(0)):NEXT
  102. 2000        ED_FLG=1:GOTO *BLOCK_PRINT
  103. 2010  *CR   BEAM=0:X_SIT=0:GOTO *MV_D
  104. 2020  *DUP  ASC_FLG=ASC_FLG XOR 1
  105. 2025        IF ASC_FLG THEN LINE (480,76)-(616,380),PRESET,,BF:RETURN
  106. 2026        FOR YL=4 TO 19:GOSUB *ASC_PRINT:NEXT:RETURN
  107. 2030  *INS  P=Y_SIT*16+X_SIT+1:A$=CHR$(0):ED_FLG=1
  108. 2040        IF Y_SIT>7 THEN 2070
  109. 2050        A$=RIGHT$(SEC$(0),1)
  110. 2060        MID$(SEC$(0),P,128)=CHR$(0)+MID$(SEC$(0),P):P=129
  111. 2070        MID$(SEC$(1),P-128,128)=A$+MID$(SEC$(1),P-128)
  112. 2080        BEAM=0:GOTO *HARF_PRINT
  113. 2090  *NEXT REC=BLK:BLK=BLK+1:GOTO *ARG_SET
  114. 2100  *BACK REC=BLK:BLK=BLK-1:GOTO *ARG_SET
  115. 2110  *EOF  REC=BLK:GOTO *ARG_SET
  116. 2120  *ESC  BEAM=0:MODE=MODE XOR 1:GOTO *MODE_PRINT
  117. 2130  *MV_R IF MODE ELSE BEAM=BEAM XOR 1:IF BEAM THEN RETURN
  118. 2140        X_SIT=X_SIT+1 AND 15:IF X_SIT=0 THEN *MV_D ELSE RETURN
  119. 2150  *MV_L IF MODE ELSE BEAM=BEAM XOR 1:IF BEAM ELSE RETURN
  120. 2160        X_SIT=X_SIT-1 AND 15:IF X_SIT=15 THEN *MV_U ELSE RETURN
  121. 2170  *MV_U Y_SIT=Y_SIT-1 AND 15:IF Y_SIT=15 THEN *BACK ELSE RETURN
  122. 2180  *MV_D Y_SIT=Y_SIT+1 AND 15:IF Y_SIT= 0 THEN *NEXT ELSE RETURN
  123. 2190  *DEL  BEAM=1:GOSUB *MV_R:BEAM=0:GOTO *BS
  124. 2200 '
  125. 2210 *HEX_SET A=INT(INSTR(HEXKEY$,KEY_DAT$)/4)-1:IF A<0 THEN RETURN
  126. 2220          GOSUB *DAT_GET:MID$(DAT$,BEAM+1,1)=HEX$(A)
  127. 2230          CHNG=VAL("&h"+DAT$):GOSUB *DAT_CHNG:GOTO *MV_R
  128. 2240 *ASC_SET CHNG=ASC(KEY_DAT$):IF CHNG<32 THEN RETURN
  129. 2250          GOSUB *DAT_GET:GOSUB *DAT_CHNG:GOTO *MV_R
  130. 2260 *DAT_CHNG
  131. 2270  GOSUB *DAT_SET:A=CHNG-DAT:ED_FLG=1
  132. 2280  X_SM(Y_SIT)=X_SM(Y_SIT)+A:Z_SM=Z_SM+A
  133. 2290  Y_SM(X_SIT)=Y_SM(X_SIT)+A:GOTO *SM_PRINT
  134. 2300 '
  135. 2310 *KEY_IN  KEY_DAT$="":WHILE KEY_DAT$="":KEY_DAT$=INKEY$:WEND:RETURN
  136. 2320 *KEY_CLR WHILE INKEY$<>"":WEND:RETURN
  137. 2330 *DAT_GET
  138. 2340  DAT=FNGET(ASCII$(Y_SIT),X_SIT):DAT$=FNHEX$(DAT):RETURN
  139. 2350 *DAT_SET
  140. 2360  MID$(ASCII$(Y_SIT),X_SIT+1,1)=CHR$(CHNG):RETURN
  141. 2370 '
  142. 2380 *ARG_GET
  143. 2390  A=BLK*256:IF A<0 THEN *移禁
  144. 2400  CALLM 0,SEG,BLK*256,ADDR:ED_FLG=0:GOTO *BLOCK_PRINT
  145. 2410 *ARG_SET
  146. 2420  IF ED_FLG ELSE *ARG_GET
  147. 2430  LOCATE 0,23:PRINT "書換えますか？";:GOSUB *KEY_CLR
  148. 2440  GOSUB *KEY_IN:IF INSTR("Yy",KEY_DAT$) ELSE GOTO *ARG_GET
  149. 2450  CALLM &H35,SEG,REC*256,ADDR:GOTO *ARG_GET
  150. 2460 *OPEN
  151. 2470  OPEN "R",#1,"(256)MEDIT.REX"
  152. 2480  FIELD #1,128 AS SEC$(0),128 AS SEC$(1)
  153. 2490  FOR I=0 TO 15:FIELD #1,I*16 AS SEC$(2),16 AS ASCII$(I):NEXT
  154. 2500  ADDR=PEEK(VARPTR(SEC$(0)),4):GOTO *ARG_GET
  155.